(* image.ml - Class describing the image object
 * Licence: LGPLv3
 * Authors: Franck "kushou" Michea < michea_f@epita.fr >
 *)

let images = Hashtbl.create 17

class image path =
object (this)
  val images		= Hashtbl.create 7
  val mutable width	= 0
  val mutable height	= 0
  val mutable filename	= ""
  val mutable colors	= ([]:Types.colorzone list)
  val mutable heights	= ([]:Types.heightzone list)

  initializer
  let img = try Sdlloader.load_image path with
      Sdlloader.SDLloader_exception _ ->
	begin
	  print_endline "The file doesn't exist or cannot be opened.";
	  exit 0;
	end in
  let w = (Sdlvideo.surface_info img).Sdlvideo.w in
  let h = (Sdlvideo.surface_info img).Sdlvideo.h in begin
    Hashtbl.add images Types.Base img;
    width <- w;
    height <- h;
    filename <- path
  end

  method private name_img_t = function
    | Types.Base | Types.RH -> "" | Types.Grey -> "in grey"
    | Types.Edges -> "edges" | Types.IWEdges -> "with edges"
    | Types.Grid | Types.Obj -> "with grid"
    | Types.NReduc -> "with noise reduction" 
    | Types.GWEdges -> "in grey with edges" 

  method private ext_img_t = function
    | Types.Base | Types.RH -> "" | Types.Grey -> ".grey"
    | Types.Edges -> ".edges" | Types.IWEdges -> ".iwedges" 
    | Types.Grid | Types.Obj -> ".grid"
    | Types.NReduc -> ".nreduc"
    | Types.GWEdges -> ".gwedges"

  method private base_img_t = function
    | Types.Edges | Types.GWEdges -> Types.Grey
    | _ -> Types.Base

  method private doesnt_exist img_t =
    let t = this#name_img_t img_t
    in begin
      Printf.printf "The image %s doesn't exists, you can't get it !" t;
      exit 0 end

  method create img_t =
    if this#exists img_t then ()
    else Hashtbl.add images img_t (this#get_copy (this#base_img_t img_t))

  method get = function
    | Types.Obj -> this#get Types.Base
    | img_t -> try Hashtbl.find images img_t with
	Not_found -> this#doesnt_exist img_t

  method get_copy img_t =
    let img = this#get img_t in
    let dst = Sdlvideo.create_RGB_surface_format img [] width height
    in begin Sdlvideo.blit_surface img dst (); dst end

  method exists img_t = Hashtbl.mem images img_t

  method get_ext img_t =
    Printf.sprintf "%s%s.bmp" filename (this#ext_img_t img_t)

  method save img_t = Sdlvideo.save_BMP (this#get img_t) (this#get_ext img_t)

  method get_colors = colors

  method get_colors_length = List.length colors

  method get_color n = List.nth colors n

  method get_heights = heights

  method get_height = height

  method get_width = width

  method get_filename = filename

  method get_heights_filename =
    filename ^ ".heights.txt"

  method get_img_zone_name n =
    Printf.sprintf "%s.%d.bmp" filename n

  method push_heights foo = heights <- foo :: heights

  method set_colors foo = colors <- foo

  method get_coord_heights x y =
    let rec find = function
      | [] -> 0
      | (h, _, l)::xs ->
	if List.mem (x,y) l then h
	else find xs
    in find heights

  method obj_filename = filename ^ ".obj"
end

let load filename =
  Hashtbl.add images filename (new image filename)

let iter f = Hashtbl.iter f images
